Load libraries
library(tidyverse)
library(plotly)
Make function to simulate paths
SimPath <- function(startvalue=100, meangrowth=0.1, sd=0.01, iterations=10) {
i <- 0
sim <- c(i)
values <- c(startvalue)
while(i < iterations) {
i <- i+1
sim <- c(sim, i)
g <- rnorm(1, meangrowth, sd)
values <- c(values, values[i]*(1+g))
}
return(data.frame(sim, values))
}
SimPath(100, 0.10, 0.01, 3)
Create graphs
# Input data
mean <- 0.30
sd <- 0.20
t <- 8
expval <- 100*(1+mean)^t
expDF <- data.frame(x=t, y=expval)
# Start calculations
n <- 1
pathsDF <- cbind(run = rep(n,t+1), SimPath(100, mean, sd, t))
while(n < 400) {
n <- n + 1
run <- rep(n,t+1)
pathsDF <- rbind(pathsDF, cbind(run, SimPath(100, mean, sd, t)))
}
pathsDF$run <- as.factor(pathsDF$run)
p <- ggplot() +
geom_line(data = pathsDF, aes(x=sim, y=values, group=run), colour="Red", alpha=1/10) +
geom_point(data = expDF, aes(x=x, y=y, text="Expected end value"), colour = "RoyalBlue", size=3) +
theme(legend.position="none")
ggplotly(p)
LS0tCnRpdGxlOiAiU2ltdWxhdGUgcmFuZG9tIHBhdGhzIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpMb2FkIGxpYnJhcmllcwoKYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRSwgcGFnZWQucHJpbnQ9RkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KHBsb3RseSkKYGBgCgoKCk1ha2UgZnVuY3Rpb24gdG8gc2ltdWxhdGUgcGF0aHMgCgpgYGB7cn0KU2ltUGF0aCA8LSBmdW5jdGlvbihzdGFydHZhbHVlPTEwMCwgbWVhbmdyb3d0aD0wLjEsIHNkPTAuMDEsIGl0ZXJhdGlvbnM9MTApIHsKICAKICBpIDwtIDAKICBzaW0gPC0gYyhpKQogIHZhbHVlcyA8LSBjKHN0YXJ0dmFsdWUpCiAgCiAgd2hpbGUoaSA8IGl0ZXJhdGlvbnMpIHsKICAgIGkgPC0gaSsxCiAgICBzaW0gPC0gYyhzaW0sIGkpCiAgICBnIDwtIHJub3JtKDEsIG1lYW5ncm93dGgsIHNkKQogICAgdmFsdWVzIDwtIGModmFsdWVzLCB2YWx1ZXNbaV0qKDErZykpCiAgfQogIHJldHVybihkYXRhLmZyYW1lKHNpbSwgdmFsdWVzKSkKfQoKU2ltUGF0aCgxMDAsIDAuMTAsIDAuMDEsIDMpCmBgYAoKQ3JlYXRlIGdyYXBocwoKYGBge3IgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KIyBJbnB1dCBkYXRhCm1lYW4gPC0gMC4zMApzZCA8LSAwLjIwCnQgPC0gOApleHB2YWwgPC0gMTAwKigxK21lYW4pXnQKZXhwREYgPC0gZGF0YS5mcmFtZSh4PXQsIHk9ZXhwdmFsKQoKIyBTdGFydCBjYWxjdWxhdGlvbnMKbiA8LSAxCnBhdGhzREYgPC0gY2JpbmQocnVuID0gcmVwKG4sdCsxKSwgU2ltUGF0aCgxMDAsIG1lYW4sIHNkLCB0KSkKd2hpbGUobiA8IDQwMCkgewogIG4gPC0gbiArIDEKICBydW4gPC0gcmVwKG4sdCsxKQogIHBhdGhzREYgPC0gcmJpbmQocGF0aHNERiwgY2JpbmQocnVuLCBTaW1QYXRoKDEwMCwgbWVhbiwgc2QsIHQpKSkKICAKfQpwYXRoc0RGJHJ1biA8LSBhcy5mYWN0b3IocGF0aHNERiRydW4pCnAgPC0gZ2dwbG90KCkgKwogIGdlb21fbGluZShkYXRhID0gcGF0aHNERiwgYWVzKHg9c2ltLCB5PXZhbHVlcywgZ3JvdXA9cnVuKSwgY29sb3VyPSJSZWQiLCBhbHBoYT0xLzEwKSArCiAgZ2VvbV9wb2ludChkYXRhID0gZXhwREYsIGFlcyh4PXgsIHk9eSwgdGV4dD0iRXhwZWN0ZWQgZW5kIHZhbHVlIiksIGNvbG91ciA9ICJSb3lhbEJsdWUiLCBzaXplPTMpICsKICB0aGVtZShsZWdlbmQucG9zaXRpb249Im5vbmUiKQoKZ2dwbG90bHkocCkKYGBgCgoK